home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / pcl_src.zoo / precom1.lsp < prev    next >
Encoding:
Text File  |  1992-07-09  |  1.9 KB  |  52 lines
  1. ;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*-
  2. ;;;
  3. ;;; *************************************************************************
  4. ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Use and copying of this software and preparation of derivative works
  8. ;;; based upon this software are permitted.  Any distribution of this
  9. ;;; software or derivative works must comply with all applicable United
  10. ;;; States export control laws.
  11. ;;; 
  12. ;;; This software is made available AS IS, and Xerox Corporation makes no
  13. ;;; warranty about the software, its performance or its conformity to any
  14. ;;; specification.
  15. ;;; 
  16. ;;; Any person obtaining a copy of this software is requested to send their
  17. ;;; name and post office or electronic mail address to:
  18. ;;;   CommonLoops Coordinator
  19. ;;;   Xerox PARC
  20. ;;;   3333 Coyote Hill Rd.
  21. ;;;   Palo Alto, CA 94304
  22. ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
  23. ;;;
  24. ;;; Suggestions, comments and requests for improvements are also welcome.
  25. ;;; *************************************************************************
  26. ;;;
  27.  
  28. (in-package 'pcl)
  29.  
  30. ;;;
  31. ;;; pre-allocate generic function caches.  The hope is that this will put
  32. ;;; them nicely together in memory, and that that may be a win.  Of course
  33. ;;; the first gc copy will probably blow that out, this really wants to be
  34. ;;; wrapped in something that declares the area static.
  35. ;;;
  36. ;;; This preallocation only creates about 25% more caches than PCL itself
  37. ;;; uses need.  Some ports may want to preallocate some more of these.
  38. ;;; 
  39. (eval-when (load)
  40.   (flet ((allocate (n size)
  41.        (mapcar #'free-cache-vector
  42.            (mapcar #'get-cache-vector
  43.                (make-list n :initial-element size)))))
  44.     (allocate 128 4)
  45.     (allocate 64 8)
  46.     (allocate 64 9)
  47.     (allocate 32 16)
  48.     (allocate 16 17)
  49.     (allocate 16 32)
  50.     (allocate 1  64)))
  51.  
  52.